home *** CD-ROM | disk | FTP | other *** search
- ;; -*- Mode:LISP; Package:(BOXER GLOBAL 1000); Base:8.; Fonts:CPTFONT -*-
-
- ;;; (C) Copyright 1983-1985 Massachusetts Institute of Technology
- ;;;
- ;;; Permission to use, copy, modify, distribute, and sell this software
- ;;; and its documentation for any purpose is hereby granted without fee,
- ;;; provided that the above copyright notice appear in all copies and that
- ;;; both that copyright notice and this permission notice appear in
- ;;; supporting documentation, and that the name of M.I.T. not be used in
- ;;; advertising or publicity pertaining to distribution of the software
- ;;; without specific, written prior permission. M.I.T. makes no
- ;;; representations about the suitability of this software for any
- ;;; purpose. It is provided "as is" without express or implied warranty.
- ;;;
-
-
- ;;; Defines all the "normal" (no ctrl- or meta- or super- or...) keys to be self inserting
- #.
- (LET ((VANILLA-KEY-CODES-NOT-TO-DEFINE '(#/| #/[ #/] #/{ #/})))
- `(PROGN 'COMPILE
- . ,(LOOP FOR KEY-CODE FROM 0 TO #O177
- UNLESS (OR (MEMQ KEY-CODE VANILLA-KEY-CODES-NOT-TO-DEFINE)
- (AND (>= KEY-CODE 141) (<= KEY-CODE 172)))
- COLLECT `(DEFBOXER-FUNCTION ,(LOOKUP-KEY-NAME KEY-CODE) COM-SELF-INSERT))))
-
- ;;; Defines all the "control" (ctrl-, meta-, or ctrl-meta- ) number keys to act as a numeric
- ;;; argument
-
- #.
- `(PROGN 'COMPILE
- . ,(LOOP FOR CONTROL-BITS FROM 1 TO 3
- APPEND (LOOP FOR KEY-CODE FROM (DPB CONTROL-BITS %%KBD-CONTROL-META 60)
- TO (DPB CONTROL-BITS %%KBD-CONTROL-META 71)
- COLLECT `(DEFBOXER-FUNCTION ,(LOOKUP-KEY-NAME KEY-CODE)
- COM-INCREMENT-NUMERIC-ARG))))
-
-
- (DEFBOXER-FUNCTION BU:CTRL-G-KEY COM-ABORT)
-
- (DEFBOXER-FUNCTION BU:SPACE-KEY COM-SPACE)
-
- (DEFBOXER-FUNCTION BU:RETURN-KEY COM-RETURN)
-
- (DEFBOXER-FUNCTION BU:QUOTE-KEY COM-QUOTE-SELF-INSERT)
-
- (DEFBOXER-FUNCTION BU:CTRL-Q-KEY COM-QUOTE-SELF-INSERT)
-
- (DEFBOXER-FUNCTION BU:CTRL-O-KEY COM-OPEN-LINE)
-
- (DEFBOXER-FUNCTION BU:RUBOUT-KEY COM-RUBOUT)
-
- (DEFBOXER-FUNCTION BU:CTRL-D-KEY COM-DELETE)
-
- (DEFBOXER-FUNCTION BU:CTRL-F-KEY COM-FORWARD-CHA)
-
- (DEFBOXER-FUNCTION BU:CTRL-B-KEY COM-BACKWARD-CHA)
-
- (DEFBOXER-FUNCTION BU:META-F-KEY COM-FORWARD-WORD)
-
- (DEFBOXER-FUNCTION BU:META-B-KEY COM-BACKWARD-WORD)
-
- (DEFBOXER-FUNCTION BU:CTRL-N-KEY COM-NEXT-ROW)
-
- (DEFBOXER-FUNCTION BU:CTRL-P-KEY COM-PREVIOUS-ROW)
-
- (DEFBOXER-FUNCTION BU:CTRL-A-KEY COM-BEGINNING-OF-ROW)
-
- (DEFBOXER-FUNCTION BU:CTRL-E-KEY COM-END-OF-ROW)
-
- (DEFBOXER-FUNCTION BU:META-<-KEY COM-BEGINNING-OF-BOX)
-
- (DEFBOXER-FUNCTION BU:META->-KEY COM-END-OF-BOX)
-
- (DEFBOXER-FUNCTION BU:CTRL-V-KEY COM-SCROLL-DN-ONE-SCREEN-BOX)
-
- (DEFBOXER-FUNCTION BU:META-V-KEY COM-SCROLL-UP-ONE-SCREEN-BOX)
-
- (DEFBOXER-FUNCTION BU:CTRL-K-KEY COM-KILL-TO-END-OF-ROW)
-
- ;;; fonts
- (DEFBOXER-FUNCTION BU:CTRL-I-KEY COM-ITALICS-FONT-CHA)
-
- (DEFBOXER-FUNCTION BU:META-I-KEY COM-ITALICS-FONT-WORD)
-
- (DEFBOXER-FUNCTION BU:CTRL-M-KEY COM-BOLDFACE-FONT-CHA)
-
- (DEFBOXER-FUNCTION BU:META-M-KEY COM-BOLDFACE-FONT-WORD)
-
- ;;; and case
- (DEFBOXER-FUNCTION META-U-KEY COM-UPPERCASE-WORD)
-
- (DEFBOXER-FUNCTION META-L-KEY COM-LOWERCASE-WORD)
-
- ;;; search
-
- (DEFBOXER-FUNCTION CTRL-S-KEY COM-FORWARD-FLAT-SEARCH)
-
- (DEFBOXER-FUNCTION CTRL-R-KEY COM-BACKWARD-FLAT-SEARCH)
-
- (DEFBOXER-FUNCTION META-S-KEY COM-FORWARD-DEEP-SEARCH)
-
- (DEFBOXER-FUNCTION META-R-KEY COM-BACKWARD-DEEP-SEARCH)
-
- ;temporarily removed until it does saving
- ;(DEFBOXER-FUNCTION BU:META-K-KEY ()
- ; (COM-KILL-TO-END-OF-BOX))
-
- (DEFBOXER-FUNCTION BU:CTRL-Y-KEY COM-YANK)
-
- (defboxer-function bu:ctrl-meta-y-key com-yank-no-copy)
-
- ;doesn't put the stuff on the screen -- just rotates it.
- (DEFBOXER-FUNCTION BU:META-Y-KEY COM-ROTATE-KILL-BUFFER)
-
- (DEFBOXER-FUNCTION BU:CTRL-META-B-KEY COM-BOXIFY-REGION)
-
- (DEFBOXER-FUNCTION BU:CTRL-L-KEY COM-FORCE-REDISPLAY)
-
- (DEFBOXER-FUNCTION BU:BREAK-KEY COM-BREAK)
-
- ;;;Regions
- (DEFBOXER-FUNCTION BU:CTRL-@-KEY COM-DEFINE-REGION)
-
- (DEFBOXER-FUNCTION BU:META-@-KEY COM-INSTALL-REGION)
-
- (DEFBOXER-FUNCTION BU:CTRL-W-KEY COM-KILL-REGION)
-
- #+3600
- (DEFBOXER-FUNCTION BU:CIRCLE-KEY COM-NAME-BOX)
- #+EXPLORER
- (DEFBOXER-FUNCTION BU:F3-KEY COM-NAME-BOX)
-
- #+CADR
- (DEFBOXER-FUNCTION BU:HAND-DOWN-KEY COM-BUG)
- #+3600
- (DEFBOXER-FUNCTION BU:SCROLL-KEY COM-BUG)
- #+EXPLORER
- (DEFBOXER-FUNCTION BU:F4-KEY COM-BUG)
-
- (DEFBOXER-FUNCTION BU:CLEAR-INPUT-KEY COM-TOGGLE-BOX-TYPE)
-
- (DEFBOXER-FUNCTION BU:{-KEY COM-MAKE-AND-ENTER-DATA-BOX)
-
- (DEFBOXER-FUNCTION BU:}-KEY COM-EXIT-BOX)
-
- (DEFBOXER-FUNCTION BU:CTRL-{-KEY COM-ENTER-BOX)
-
- (DEFBOXER-FUNCTION BU:CTRL-}-KEY COM-EXIT-BOX)
-
- (DEFBOXER-FUNCTION BU:[-KEY COM-MAKE-AND-ENTER-BOX)
-
- (DEFBOXER-FUNCTION BU:]-KEY COM-EXIT-BOX)
-
- (DEFBOXER-FUNCTION BU:/(-KEY COM-MAKE-AND-ENTER-BOX)
-
- (DEFBOXER-FUNCTION BU:/)-KEY COM-EXIT-BOX)
-
- (DEFBOXER-FUNCTION BU:CTRL-/(-KEY COM-ENTER-BOX)
-
- (DEFBOXER-FUNCTION BU:CTRL-/)-KEY COM-EXIT-BOX)
-
- (DEFBOXER-FUNCTION BU:CTRL-[-KEY COM-ENTER-BOX)
-
- (DEFBOXER-FUNCTION BU:CTRL-]-KEY COM-EXIT-BOX)
-
- (DEFBOXER-FUNCTION BU:CTRL-<-KEY COM-COLLAPSE-BOX)
-
- (DEFBOXER-FUNCTION BU:CTRL->-KEY COM-EXPAND-BOX)
-
- (DEFBOXER-FUNCTION BU:CTRL-META-<-KEY COM-GOTO-TOP-LEVEL)
-
- (DEFBOXER-FUNCTION CTRL-=-KEY COM-FIX-BOX-SIZE)
-
- (DEFBOXER-FUNCTION META-=-KEY COM-UNFIX-BOX-SIZE)
-
- (DEFBOXER-FUNCTION CTRL-+-KEY COM-MAKE-SHRINK-PROOF-SCREEN)
-
- (DEFBOXER-FUNCTION META-+-KEY COM-UNSHRINK-PROOF-SCREEN)
-
- (DEFBOXER-FUNCTION CTRL-SPACE-KEY COM-MAKE-PORT)
-
- (DEFBOXER-FUNCTION META-SPACE-KEY COM-PLACE-PORT)
-
- (DEFBOXER-FUNCTION META-RUBOUT-KEY COM-RUBOUT-WORD)
-
- (DEFBOXER-FUNCTION META-D-KEY COM-DELETE-WORD)
-
- #+CADR
- (DEFBOXER-FUNCTION BU:ALTMODE-KEY COM-PROMPT)
- #+3600
- (DEFBOXER-FUNCTION BU:COMPLETE-KEY COM-PROMPT)
- #+(OR 3600 EXPLORER)
- (DEFBOXER-FUNCTION BU:ESCAPE-KEY COM-PROMPT)
-
- ;The 3600 lacks a status key, but has a LOCAL key which generates #\QUOTE
- #+3600
- (DEFBOXER-FUNCTION BU:CTRL-CIRCLE-KEY COM-EDIT-LOCAL-LIBRARY)
- #-3600
- (DEFBOXER-FUNCTION BU:STATUS-KEY COM-EDIT-LOCAL-LIBRARY)
- #+EXPLORER
- (DEFBOXER-FUNCTION BU:CTRL-F3-KEY COM-EDIT-LOCAL-LIBRARY)
-
- (DEFBOXER-FUNCTION BU:HELP-KEY COM-HELP)
-
- (DEFBOXER-FUNCTION CTRL-HELP-KEY COM-COMMAND-HELP)
-
- (DEFBOXER-FUNCTION META-HELP-KEY COM-APROPOS-HELP)
-
- (DEFBOXER-FUNCTION BU:END-KEY COM-DOIT)
-
- (DEFBOXER-FUNCTION BU:CTRL-END-KEY COM-DOIT-NOW)
-
- (DEFBOXER-FUNCTION BU:META-END-KEY COM-UNMARK-REGION)
-
- (defboxer-function bu:line-key com-doit-now)
-
- (DEFBOXER-FUNCTION BU:META-LINE-KEY com-doit-now-give-lispm-errors)
-
- (define-key-name 'bu:step-key #-3600 #\MACRO
- #+3600 #\page)
-
- (defboxer-function bu:step-key com-step-through-box)
-
- #+3600
- (DEFBOXER-FUNCTION BU:SQUARE-KEY COM-MAKE-GRAPHICS-BOX)
- #+EXPLORER
- (DEFBOXER-FUNCTION BU:F1-KEY COM-MAKE-GRAPHICS-BOX)
-
- #+3600
- (DEFBOXER-FUNCTION BU:CTRL-SQUARE-KEY COM-MAKE-GRAPHICS-DATA-BOX)
- #+EXPLORER
- (DEFBOXER-FUNCTION BU:CTRL-F1-KEY COM-MAKE-GRAPHICS-DATA-BOX)
-
- #+3600
- (DEFBOXER-FUNCTION BU:TRIANGLE-KEY COM-MAKE-SPRITE-BOX)
- #+EXPLORER
- (DEFBOXER-FUNCTION BU:F2-KEY COM-MAKE-SPRITE-BOX)
-
- (DEFBOXER-FUNCTION BU:CTRL-CLEAR-INPUT-KEY ()
- (COM-TOGGLE-INTO-GRAPHICS-BOX))
-
- ;;;strange lossage where CTRL-CLEAR-INPUT isn't being tyi'd
- #+EXPLORER
- (DEFBOXER-FUNCTION BU:META-F1-KEY COM-TOGGLE-INTO-GRAPHICS-BOX)
-
- (setq WHO-LINE-DOCUMENTATION-STRING
- "L:Make Box Smaller, L2:Make Box Tiny, M:Move To Box, R:Make Box Larger, R2:Make Box Full Screen")
-
- (DEFBOXER-FUNCTION MOUSE-LEFT-ONCE (WINDOW X Y)
- (LET ((SPRITE (TELL *SPRITE-BLINKER* :SELECTED-SPRITE)))
- (IF (NOT (NULL SPRITE))
- (COM-SPRITE-LEFT-CLICK SPRITE)
- (COM-MOUSE-COLLAPSE-BOX WINDOW X Y))))
-
- (DEFBOXER-FUNCTION MOUSE-RIGHT-ONCE (WINDOW X Y)
- (LET ((SPRITE (TELL *SPRITE-BLINKER* :SELECTED-SPRITE)))
- (IF (NOT (NULL SPRITE))
- (COM-SPRITE-RIGHT-CLICK SPRITE)
- (COM-MOUSE-EXPAND-BOX WINDOW X Y))))
-
- (DEFBOXER-FUNCTION MOUSE-MIDDLE-ONCE (WINDOW X Y)
- (LET ((SPRITE (TELL *SPRITE-BLINKER* :SELECTED-SPRITE)))
- (IF (NOT (NULL SPRITE))
- (COM-SPRITE-MIDDLE-CLICK SPRITE)
- (COM-MOUSE-MOVE-POINT WINDOW X Y))))
-
- (DEFBOXER-FUNCTION MOUSE-LEFT-TWICE (WINDOW X Y)
- (COM-MOUSE-SHRINK-BOX WINDOW X Y))
-
- (DEFBOXER-FUNCTION MOUSE-RIGHT-TWICE (WINDOW X Y)
- (COM-MOUSE-SET-OUTERMOST-BOX WINDOW X Y))
-
- (DEFBOXER-FUNCTION MOUSE-MIDDLE-DOWN (WINDOW X Y)
- (LET ((SPRITE (TELL *SPRITE-BLINKER* :SELECTED-SPRITE)))
- (IF (NOT (NULL SPRITE))
- (COM-MOUSE-GRAB-SPRITE SPRITE)
- (COM-MOUSE-DEFINE-REGION WINDOW X Y))))
-
- (DEFBOXER-FUNCTION MOUSE-MIDDLE-UP (WINDOW X Y)
- (COM-MOUSE-RELEASE-REGION WINDOW X Y))
-
- (COMMENT
-
- (DEFBOXER-FUNCTION MOUSE-LEFT-ONCE (WINDOW X Y)
- (COM-MOUSE-FANCY-LEFT WINDOW X Y))
-
- (DEFBOXER-FUNCTION MOUSE-RIGHT-ONCE (WINDOW X Y)
- (COM-MOUSE-FANCY-UP WINDOW X Y))
-
- (DEFVAR MOUSE-FANCY-LEFT-DIRECTION -1)
- (DEFVAR MOUSE-FANCY-UP-DIRECTION -1)
-
- (DEFUN MOUSE-FANCY-LEFT-COMPLEMENT-DIRECTION ()
- (IF (MINUSP MOUSE-FANCY-LEFT-DIRECTION)
- (SETQ MOUSE-FANCY-LEFT-DIRECTION 1)
- (SETQ MOUSE-FANCY-LEFT-DIRECTION -1)))
-
- (DEFUN MOUSE-FANCY-UP-COMPLEMENT-DIRECTION ()
- (IF (MINUSP MOUSE-FANCY-UP-DIRECTION)
- (SETQ MOUSE-FANCY-UP-DIRECTION 1)
- (SETQ MOUSE-FANCY-UP-DIRECTION -1)))
-
- (DEFUN COM-MOUSE-FANCY-LEFT (&REST IGNORE)
- (MOUSE-FANCY-MOVE)
- (MOUSE-FANCY-LEFT-COMPLEMENT-DIRECTION))
-
- (DEFUN COM-MOUSE-FANCY-UP (&REST IGNORE)
- (MOUSE-FANCY-MOVE)
- (MOUSE-FANCY-UP-COMPLEMENT-DIRECTION))
-
- (DEFUN MOUSE-FANCY-MOVE (&REST IGNORE)
- (LET ((DELTA 2))
- (LOOP UNTIL (ZEROP TV:MOUSE-LAST-BUTTONS)
- DO (TV:MOUSE-WARP (IF (BIT-TEST #O1 TV:MOUSE-LAST-BUTTONS)
- (FIX (+ TV:MOUSE-X (* MOUSE-FANCY-LEFT-DIRECTION DELTA)))
- TV:MOUSE-X)
- (IF (BIT-TEST #O4 TV:MOUSE-LAST-BUTTONS)
- (FIX (+ TV:MOUSE-Y (* MOUSE-FANCY-UP-DIRECTION DELTA)))
- TV:MOUSE-Y))
- (SETQ DELTA (MIN 24. (* 2 DELTA)))
- (PROCESS-WAIT "Sleep"
- #'(LAMBDA (WAKEUP) (OR (> (TIME) WAKEUP)
- (ZEROP TV:MOUSE-LAST-BUTTONS)))
- (+ (TIME) 20.)))))
-
- )
-